home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf
/
GFA.Anwendung
/
Verkehrstest_V1.00c.LST
< prev
next >
Wrap
File List
|
1992-09-14
|
23KB
|
620 lines
' ***********************************************
' * *
' * Verkehrstest V 1.00c © 29.9.1991 by *
' * *
' * Henry König, Bornheide 71, 2000 Hamburg 53 *
' * *
' ***********************************************
RESERVE 100000
init ! Variablen initialisieren
ON MENU BUTTON GOSUB mauskontrolle
start: ! Sprungmarke der Fehlerroutine
REPEAT ! Warteschleife für die Mauskontrolle
SLEEP
UNTIL ende!
CLOSES 1 ! Bildschirm schließen
CLOSEW #1 ! Fenster schließen
END ! Ende
PROCEDURE anweisung(aw%)
PRINT AT(4,ax%(aw%));SPACE$(74) ! Zeile löschen
PRINT AT(ay%(aw%),ax%(aw%));aw$(aw%) ! Anweisung ausgeben
RETURN
PROCEDURE auswertung ! Antworten ausgeben
IF aw%(1)=zahl%(1) THEN
PCOLOR 6
ELSE
PCOLOR 3
berechnung%=1
ENDIF
PRINT AT(10,9);anw$(0)
PRINT AT(10,10);anw$(1)
IF aw%(2)=zahl%(2) THEN
PCOLOR 6
ELSE
PCOLOR 3
berechnung%=1
ENDIF
PRINT AT(10,12);anw$(2)
PRINT AT(10,13);anw$(3)
IF aw%(3)=zahl%(3) THEN
PCOLOR 6
ELSE
PCOLOR 3
berechnung%=1
ENDIF
PRINT AT(10,15);anw$(4)
PRINT AT(10,16);anw$(5)
IF berechnung%=1 THEN
fehlerpunkte%=fehlerpunkte%+fehler%
berechnung%=0
ENDIF
IF aw%(1)=zahl%(1) AND aw%(2)=zahl%(2) AND aw%(3)=zahl%(3) THEN
hilf%(z%)=1
i%=i%-1
ENDIF
tastendruck1 ! auf Tastendruck oder Mausklick warten
FOR j%=1 TO 3
aw%(j%)=0
g%(j%)=1
NEXT j%
IF fehlerpunkte%>8 OR i%<=1 THEN
testergebniss
GOTO auswertung.ende
ENDIF
i%=i%-1 ! Fragenzähler minus 1
naechste: ! nächste Frage bestimmen
z%=1+RAND(n%) ! Nummer der Frage per Zufall bestimmen
IF fraz%>=30 THEN ! Fragebogen hat 30 Fragen
testergebniss
GOTO auswertung.ende
ENDIF
z%=z%-1 ! Nummer der Frage minus 1
IF z%>i% THEN
z%=1
ENDIF
IF z%<=1 THEN
i%=n% ! Anzahl der Fragen
z%=1+RAND(n%) ! Nummer der Frage per Zufall bestimmen
ENDIF
IF hilf%(z%)=0 THEN
frage.stellen ! nächste Frage stellen
GOTO auswertung.ende
ELSE
i%=n% ! Anzahl der Fragen
GOTO naechste
ENDIF
auswertung.ende:
RETURN
PROCEDURE beenden ! Programm beenden
ALERT 0,"Wollen Sie aufhören",1,"Ende|Weiter",wahl%
ende!=(wahl%=1)
RETURN
PROCEDURE cursor.aus
LOCATE spalte%+sp%,zeile% ! Cursor positionieren
textstil(0,1,0) ! Invers ausschalten
PRINT MID$(t$,sp%,1) ! Zeichen ausgeben
RETURN
PROCEDURE daten ! Daten für Menüs und Anweisungen
DATA 31, 5,"Variable Anweisung",0
DATA 28,12,"",1
DATA 28,30,"Sind Sie sicher",2
DATA 28,22,"Sind alle Angaben richtig",3
DATA 31, 6,"",4
DATA 31,24,"",5
DATA 2, 4,"",6
DATA 28,25,"",7
DATA 28, 4,"",8
DATA 31,10,"",9
DATA 31, 4,"Feldposition im Druck ändern. Reihenfolge eingeben. 0 = nicht Ausgeben.",10
DATA 31,14,"Eingabefelder mit | markieren. Masken-Editor mit Esc beenden",11
DATA 31,18,"Bitte ewas Geduld. Die Maske wird überprüft.",12
DATA 28,20,"Fehler in der Maske. Korrigieren",13
DATA 31, 4,"Dateneingabe oder Datenänderung können Sie nur mit der 'Esc'-Taste beenden.",14
DATA 31, 4,"Index-(Sortier)Felder durch Ziffern (1 -)an und bestätigen die Eingabe mit Esc.",15
DATA 31, 8,"Unterbrechung mit beliebiger Taste, Abbruch mit der « Esc-Taste » ",16
DATA 31, 4,"Bei RETURN wird jedes Datenfeld übernommen, sonst wird selektiert.",17
DATA 31, 4,"Anwahl = linke Maustaste, Cursor, Buchst. Start = rechte Maustaste, RETURN",18
DATA 28,10,"Soll die Konfiguratiom gespeichert werden",19
DATA 31, 4,"",20
DATA 28,10,"Fragen-Datei 'Verkehr.Daten' oder 'Verkehr.Maske' auswählen.",21
DATA 28, 4,"",22
DATA 28,13,"Soll die neue Datei auf Festplatte",23
DATA 28,20,"Datenfeld mehrfach gewählt. Korrigieren",24
DATA 28,10,"Ausgabefelder (Reihenfolge) ändern oder unterdrücken",25
DATA 28, 4,"Sie haben die Maske verändert. Datei neu organisieren",26
DATA 31,10,"V e r k e h r s t e s t V1.00c © 29.9.1991 by Henry König",27
DATA 31,10,"Der interne Speicher ist voll. Weiter mit beliebiger Taste",28
DATA 28, 4,"Achtung es sind Vorgabeflags gesetzt. Vorgabe berücksichtigen",29
DATA 31, 4,"= ersetzen, <> entfernen, < voranstellen, > anfügen, * Instring",30
DATA 28,14,"Soll dieser Datensatz verändert werden",31
DATA 22,20,"Übernommenen Datensatz ergänzen",32
DATA 31, 4,"Ordner sind mit '*' gekennzeichet. Zum Ordnerwechsel nur einmal klicken.",33
DATA 28, 4,"Auswertung in neue Datei (J), an vorhandene Datei anhängen (N)",34
DATA 28, 4,"Druckzeile ist zu lang. Druckersteuerung durchs Programm",35
DATA 28, 4,"Speichermangel. Zusätzliche Indexfelder entfernen",36
RETURN
PROCEDURE eingabe(sp%,zeile%,spalte%,lg%,t$)
undo1$=t$ ! Eingabe sichern
eingabe0:
PRINT AT(spalte%+1,zeile%);t$ ! String auf Bildschirm
eingabe1:
IF sp%<1 THEN ! Spalte < 1
sp%=1 ! ja, dann Spalte = 1
ELSE IF sp%>lg% ! Spalte > Stringlaenge
sp%=lg% ! ja, dann Spalte = Stringlaenge
ENDIF
LOCATE spalte%+sp%,zeile% ! Cursor positionieren
textstil(7,3,6) ! Invers an
PRINT MID$(t$,sp%,1) ! Zeichen ausgeben
textstil(0,1,0) ! Invers aus
taste ! Zeichen von Tastatur holen
IF mausy%>0 THEN ! mit Maus positioniert
cursor.aus ! Ersatz-Cursor aus
IF (cf% AND mausy%<>zeile%) OR (cf% AND mausx%<spalte%) OR (cf% AND mausx%>spalte%+lg%) THEN
GOTO eingabe.ende ! ja, dann Ende
ELSE
sp%=mausx%-spalte% ! Spaltenposition = Mausspalte-Spalte
ENDIF
ENDIF
IF cf%=1 THEN ! Datenfeld links/rechts
IF x%=12 OR x%=18 OR x%=20 OR x%=22 THEN !
GOTO eingabe.ende
ENDIF
ENDIF
IF x%=13 OR x%=27 THEN ! Abbbruch durch Esc oder RETURN?
GOTO eingabe.ende
ELSE IF x%=155 ! Sondertasten
x%=ASC(MID$(x$,2,1)) ! ASCII-Wert
cursor.aus ! Ersatz-Cursor ausschalten
IF x%=65 AND cf%=1 OR x%=66 AND cf%=1 THEN ! Abbbruch
GOTO eingabe.ende
ENDIF
IF x%=63 THEN ! HELP-Taste
ELSE IF x%=67 ! Cursor rechts
INC sp% ! ja, dann Spalte +1
ELSE IF x%=68 ! Cursor links
DEC sp% ! ja, dann Spalte -1
ELSE IF x%=90 ! TAB links
sp%=sp%-8 ! Spalte -8
ENDIF
ELSE IF x%=127 ! Delete
t$=LEFT$(t$,sp%-1)+MID$(t$,sp%+1,lg%-sp%)+" " ! Zeichen löschen
ELSE IF x%<32 OR x%>127 AND x%<160 ! Steuerzeichen?
cursor.aus
IF x%=8 AND sp%>1 THEN ! Backspace
t$=LEFT$(t$,sp%-2)+MID$(t$,sp%,lg%-sp%+1)+" " ! Leerzeichen einfügen
sp%=sp%-1 ! Spalte -1
ELSE IF x%=4 ! Ctrl-d
t$=SPACE$(lg%) ! ja, dann String löschen
ELSE IF x%=9 ! TAB rechts
sp%=sp%+8 ! ja, dann Spalte +8
ELSE IF x%=16 ! Crtl-p
auto.insert%=NOT auto.insert% ! ja, dann Insertflag ändern
CLR x% ! Steuerzeichen löschen
IF auto.insert%=0 THEN
PRINT AT(2,29);"Insert aus"
ELSE
PRINT AT(2,29);"Insert an "
ENDIF
ELSE IF x%=21 ! Ctrl-u = Feld einfügen
t$=LEFT$(undo$+SPACE$(lg%),lg%) ! Text aus Puffer auf Sollänge bringen
ELSE IF x%=25 ! Ctrl-y = Feld löschen
undo$=t$ ! Text zwischenspeichern
t$=SPACE$(lg%) ! String löschen
sp%=1 ! Spalte = 1
ENDIF
ELSE ! gültiges ASCII-Zeichen übernehmen
IF auto.insert% THEN ! Einfügemodus eingeschaltet?
t$=LEFT$(t$,sp%-1)+x$+MID$(t$,sp%,lg%-sp%) ! ja, dann Zeichen einfügen
ELSE ! Überschreibmodus
MID$(t$,sp%,1)=x$ ! Zeichen überschreiben
ENDIF
INC sp% ! Spalte +1
ENDIF
GOTO eingabe0
eingabe.ende:
cursor.aus ! Ersatz-Cursor ausschalten
tx$=t$ ! Rückgabestring an die aufrufende Procedure
sp1%=sp%
RETURN
PROCEDURE farben.setzen
SETCOLOR 0,5,5,5 ! grau statt blau
SETCOLOR 1,15,15,15 ! weiß bleibt
SETCOLOR 2,0,0,0 ! schwarz erhalten
SETCOLOR 3,15,5,0 ! rot bleibt
SETCOLOR 4,10,10,10 ! hellgrau
SETCOLOR 5,0,0,15 ! blau
SETCOLOR 6,15,15,0 ! gelb
SETCOLOR 7,0,0,0 ! schwarz erhalten
RETURN
PROCEDURE frage.stellen ! Fragebogen
fraz%=fraz%+1 ! Zähler für die gestellten Fragen plus 1
berechnung%=0 ! Berechnungsflag zurücksetzen
FOR j%=1 TO 3
aw%(j%)=0 ! Flags der Antworten löschen
g%(j%)=1 ! Flags der gedrückten Tasten setzen
NEXT j%
programmkopf
COLOR 2 ! schwarze Farbe
PBOX 1,22,639,58 ! Fragenbox
COLOR 0 ! graue Farbe
PBOX 7,25,633,55 ! Fragenbox
COLOR 4 ! hellgraue Farbe
LINE 7,25,7,54 ! Linien für 3D-Effekt
LINE 7,25,631,25
LINE 11,54,631,54
LINE 631,26,631,53
COLOR 2 ! schwarze Farbe
LINE 11,27,11,53 ! senkrechter Strich (links)
LINE 12,27,12,53 ! senkrechter Strich (links)
LINE 11,27,627,27 ! waagerechter Strich (oben)
PCOLOR 6
PRINT AT(10,2);"F R A G E B O G E N"
COLOR 7 ! schwarze Farbe
PBOX 14,61,56,83 ! 1. Auswahlbox
PBOX 14,85,56,107 ! 2. Auswahlbox
PBOX 14,109,56,131 ! 3. Auswahlbox
PBOX 14,181,56,203 ! Bestätigungsbox
COLOR 4
PBOX 18,63,52,81 ! 1. Auswahlbox
PBOX 18,87,52,105 ! 2. Auswahlbox
PBOX 18,111,52,129 ! 3. Auswahlbox
PBOX 18,183,52,201 ! Bestätigungsbox
COLOR 0
PBOX 20,64,50,80 ! 1. Auswahlbox
PBOX 20,88,50,104 ! 2. Auswahlbox
PBOX 20,112,50,128 ! 3. Auswahlbox
PBOX 20,184,50,200 ! Bestätigungsbox
PCOLOR 3
PRINT AT(13,28);"Fehlerhafte Antworten werden in roter Schrift angegeben."
PCOLOR 6
PRINT AT(10,25);"Eingabe (Antworten) auswerten"
PRINT AT(4,31);"Erreichte Fehlerpunkte: ";
PCOLOR 3
PRINT fehlerpunkte%
PCOLOR 6
PRINT AT(33,31);"Mögliche Fehlerpunkte bei dieser Frage: ";
PCOLOR 1
PRINT fehler%
PCOLOR 6
PRINT AT(45,2);"Frage Nummer: ";
PRINT fraz%; ! Nummer der Frage anzeigen
PRINT " gesamt: ";n%
COLOR 6,0
satz.lesen ! Frage aus der Datei lesen
FOR j%=0 TO 2 ! Fragen ausgeben
anw$(j%)=te$(j%+1)
' TEXT 32,j%*8+4.5*8,anw$(j%)
TEXT 20,j%*8+4.5*8,anw$(j%)
NEXT j%
PCOLOR 1,0 ! weiße Schrift
FOR j%=0 TO 5
anw$(j%)=te$(j%+4) ! Antworten merken
NEXT j%
PRINT AT(10,9);anw$(0) ! mögliche Antworten ausgeben
PRINT AT(10,10);anw$(1)
PRINT AT(10,12);anw$(2)
PRINT AT(10,13);anw$(3)
PRINT AT(10,15);anw$(4)
PRINT AT(10,16);anw$(5)
FOR j%=1 TO 3 ! Fragen ausgeben
zahl%(j%)=VAL(te$(j%+9))
NEXT j%
fehler%=VAL(te$(13))
RETURN
PROCEDURE index.pos ! Feldposition feststellen
po%(1)=1
FOR j%=1 TO be% ! Bildschirmpos. der Datenfelder berechnen
po%(j%+1)=po%(j%)+td%(j%)
NEXT j%
RETURN
PROCEDURE info
programmkopf
PCOLOR 6,0
PRINT AT(20,2);"V e r k e h r s t e s t Version 1.00"
PCOLOR 1,0
PRINT AT(1,7);"Ein Programm zur Vorbereitung auf die theoretische Fahrprüfung."
PRINT AT(1,9);"Eine Gewähr für die Richtigkeit der Fragen und Antworten kann nicht"
PRINT AT(1,11);"übernommen werden"
PRINT AT(1,13);"Es sind zur Zeit nur die Textfragen enthalten."
PRINT AT(1,15);"Dieses Programm kann und soll keine Fahrschulbücher ersetzen."
PRINT AT(1,25);"Dieses Programm darf kopiert und in jede PD-Serie übernommen werden."
PCOLOR 5,0
PRINT AT(10,31);"© 31.08.1991 by Henry König, Bornheide 71, 2000 Hamburg 53"
tastendruck
RETURN
PROCEDURE init ! Variable initialisieren
OPENS 1,0,0,640,256,3,&H8000
OPENW #1,0,0,640,256,&H18,&H1800,1
RANDOMIZE TIMER ! Zufallgenerator starten
farben.setzen
info ! Info über das Programm ausgeben
n%=400 ! Anzahl der Fragen und Antworten 1
ON ERROR GOSUB fehler
MODE 0
CLR x2%
un%=11 ! Anzahl der Datenpflegemenüs
at%=36 ! Anzahl der Anweisungen
ez%=21 ! Zeilenanzahl der Bildschirmmaske
fz%=21 ! Anz. Datenfelder
DIM frage$(2,n%) ! Speicher fur die Fragen
DIM anw$(5) ! Speicher fur die Antworten
DIM zahl%(3) ! 1= ja, 0=nein
DIM g%(3) ! Flag fur gewählte Antwortbox
DIM aw%(3) ! Flags für die Auswertung
DIM hilf%(n%)
'
DIM m$(ez%) ! Bildschirmmaske
DIM mx%(ez%),my%(ez%) ! Zeilen und Spalten der Datenfelder (Maske)
DIM ax%(at%),ay%(at%),aw$(at%)! Anweisungstexte und Position
DIM pfad$(3),d$(3),maske$(3) ! Pfadnamen und Dateinamen
DIM te$(fz%),td$(fz%),td%(fz%)! Feldinhalt, Datenfeldname und Datenfeldlänge
DIM po%(fz%)
FOR j%=0 TO at%
READ ax%(j%),ay%(j%),aw$(j%),dummy%
NEXT j%
maske.einlesen
IF abbruch%=1 THEN
beenden
ELSE
ini !
ENDIF
RETURN
PROCEDURE ini ! 1. Frage stellen
oeffne.i ! Dateigröße feststellen
i%=n%
oeffne.r ! Relative Datei öffnen
CLR fehlerpunkte% ! Fehlerpunkte löschen
z%=1+RAND(n%) ! Nummer der Frage per Zufall bestimmen
' z%=INT(RND*(i%-1)) ! Nummer der Frage per Zufall bestimmen
CLR fraz% ! Fragenzähler zurücksetzen
frage.stellen ! 1. Frage stellen
RETURN
PROCEDURE maske.einlesen ! Maske vom Datenträger lesen
programmkopf
anweisung(21) ! Namen der Arbeitsdatei
anweisung(33) ! Ordner sind mit...
programmname
IF abbruch%=0 THEN
OPEN "i",#1,pfad$(x2%)+maske$(x2%)
INPUT #1,ms%,be%,le%,dl%,dz%
FOR j%=1 TO ez%
LINE INPUT #1,m$(j%)
INPUT #1,mx%(j%),my%(j%)
NEXT j%
FOR j%=1 TO fz%
LINE INPUT #1,x$
LINE INPUT #1,x$
LINE INPUT #1,x$
INPUT #1,td%(j%)
NEXT j%
CLOSE #1 ! Datei wieder schließen
index.pos ! Feldposition berechnen
ENDIF
RETURN
PROCEDURE mauskontrolle ! Mauskontrolle für den Fragebogen
IF arbeit%=0 THEN !
CLR x% ! Mausposition löschen
CLR y%
IF MENU(2)=&H68 THEN ! linke Maustaste gedrückt?
MOUSE x%,y%,mausk% ! ja, dann Position merken
IF x%>125 AND x%<145 THEN ! Box für neuen Test gewählt
IF y%>140 AND y%<155 THEN
test.starten ! ja, dann neuen Test starten
ELSE IF y%>165 AND y%<180
beenden ! nein, dann Programm beenden
ENDIF
ENDIF
IF x%>20 AND x%<50 THEN ! Antwortboxen gewählt
IF y%>64 AND y%<80 THEN ! 1. Antwortbox gewählt
IF g%(1)=1 THEN ! Feld schon angekreuzt?
aw%(1)=1
g%(1)=0
COLOR 5
LINE 20,64,50,80 ! Feld ankreuzen
LINE 50,64,20,80
ELSE ! Feld ist angekreuzt
aw%(1)=0
g%(1)=1
COLOR 0
PBOX 21,65,49,79 ! Kreuz entfernen
ENDIF
ELSE IF y%>88 AND y%<104 ! 2. Antwortbox gewählt
IF g%(2)=1 THEN
aw%(2)=1
g%(2)=0
COLOR 5
LINE 20,88,50,104 ! 2. Box ankreuzen
LINE 50,88,20,104
ELSE ! 2. Antwortbox war schon angekreuzt
aw%(2)=0
g%(2)=1
COLOR 0
PBOX 21,89,49,103 ! Kreuz löschen
ENDIF
ELSE IF y%>112 AND y%<128 ! 3. Antwortbox gewählt
IF g%(3)=1 THEN
aw%(3)=1
g%(3)=0
COLOR 5
LINE 20,112,50,128 ! Box ankreuzen
LINE 50,112,20,128
ELSE ! 3. Antwortbox war angekreuzt
aw%(3)=0
g%(3)=1
COLOR 0
PBOX 21,113,49,127 ! Kreuz entfernen
ENDIF
ELSE IF y%>184 AND y%<200 ! Antwort auswerten
SOUND 661.63,2,255 ! Klick
auswertung ! Antworten auswerten
ELSE
' hier eine WEITERBOX einfügen
CLR x% ! Mausposition löschen, damit ein Unterprog.
CLR y% ! nicht zweimal ausgeführt wird
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
PROCEDURE oeffne.i ! Dateigröße feststellen
OPEN "I",#1,pfad$(x2%)+d$(x2%)
lo%=LOF(#1) ! Dateigröße
n%=lo%/le% ! Anzahl der gespeicherten Datensätze
CLOSE #1 ! Datei schließen
RETURN
PROCEDURE oeffne.r ! Relative Datei öffnen
OPEN "R",#1,pfad$(x2%)+d$(x2%),le%
FIELD #1,(le%) AS record$
RETURN
PROCEDURE programmkopf
CLS
COLOR 2 ! schwarze Box
PBOX 1,1,639,20
COLOR 0 ! grau
PBOX 6,4,633,17
COLOR 4 ! hellgrau
LINE 6,4,633,4
LINE 6,4,6,17
PRINT AT(2,2);SPACE$(78)
PCOLOR 6,0
PCOLOR 1,0
programmfuss
RETURN
PROCEDURE programmfuss ! Anweisungsboxen zeichnen
COLOR 2 ! schwarz
PBOX 1,(27*8)-10,639,(32*8) ! schwarze Box
COLOR 0 ! grau
PBOX 6,(27*8)-7,633,(28*8)+4 ! graue Box
PBOX 6,(29*8)+2,633,(32*8)-4 ! 2. graue Box
COLOR 4 ! hellgrau
BOX 7,(27*8)-7,633,(32*8)-3
LINE 7,(29*8)+2,633,(29*8)+2
LINE 16,(29*8)-6,639-16,(29*8)-6
LINE 16,(29*8)+5,639-16,(29*8)+5
LINE 639-16,(29*8)-6,639-16,(26*8)+4 ! senkrechter Strich
LINE 16,(29*8)+5,16,(31*8)+2 ! senkrechter Strich
COLOR 2 ! schwarz
LINE 7,(32*8)-3,633,(32*8)-3 ! schwarze Linie
LINE 633,(27*8)-7,633,(32*8)-3
LINE 16,(27*8)-4,639-16,(27*8)-4
LINE 16,(31*8)+2,639-16,(31*8)+2
LINE 16,(29*8)-6,16,(26*8)+4 ! senkrechter Strich
LINE 639-16,(29*8)+5,639-16,(31*8)+2 ! senkrechter Strich
RETURN
PROCEDURE programmauswahl(titel$,oktext$,VAR pfad$,dateiname$)
FILESELECT titel$,oktext$,pfad$,dateiname$
pos1%=RINSTR(dateiname$,"/")
pos2%=RINSTR(dateiname$,":")
IF pos1%>0 THEN ! Dateipfad herausfiltern
pfad$=MID$(dateiname$,1,pos1%)
dateiname$=MID$(dateiname$,pos1%+1)
ELSE IF pos2%>1 AND pos1%=0 ! Laufwerk nach Drive$()
pfad$=LEFT$(dateiname$,pos2%)
dateiname$=MID$(dateiname$,pos2%+1)
ENDIF
RETURN
PROCEDURE programmname
pfad$=pfad$(x2%) ! Pfad übergeben für Fileselect
IF pfad$="" THEN
pfad$=DIR$(0) ! aktuelles Laufwerk übernehmen
ENDIF
programmauswahl("Datei auswählen","OK",pfad$,dateiname$)
IF dateiname$="" THEN
abbruch%=1 ! Abbruchflag setzen
ELSE
CLR abbruch% ! Abbruchflag löschen
x$=UPPER$(RIGHT$(dateiname$,6))
IF x$=".DATEN" OR x$=".MASKE" THEN
dateiname$=LEFT$(dateiname$,LEN(dateiname$)-6)
ENDIF
d$(x2%)=dateiname$+".Daten" ! Datenbankname
maske$(x2%)=dateiname$+".Maske"! Name der Konfigurationsdatei
ENDIF
pfad$(x2%)=pfad$ ! Pfad sichern für nächstes Fileselect
RETURN
PROCEDURE maustaste ! ein Zeichen von der Tastatur holen
arbeit%=1 ! Mauskontrolle verhindern
CLR x% ! Steuerzeichen löschen
CLR y%
WHILE x%<51 OR MOUSEK=0
x$=INKEY$ ! Zeichen von Tastatur
IF MOUSEK<>0 THEN ! linke Maustaste
MOUSE x%,y%,mausk% ! Maustaste
ENDIF
WEND
arbeit%=0 ! Mauskontrolle wieder einschalten
RETURN
PROCEDURE satz.lesen ! einen Datensatz lesen
rn%=z% ! Recordnummer
GET #1,rn% ! Satz lesen
FOR j1%=1 TO be%
te$(j1%)=MID$(record$,po%(j1%),td%(j1%))
NEXT j1%
RETURN
PROCEDURE taste ! ein Zeichen von der Tastatur holen
CLR x% ! Steuerzeichen löschen
CLR mausk%
CLR mausx% ! Mausspalte löschen
CLR mausy% ! Mauszeile löschen
WHILE x%=0 AND MOUSEK=0
x$=INKEY$ ! Zeichen von Tastatur
x%=ASC(x$) ! ASCII-Wert für Auswertung
WEND
IF MOUSEK<>0 THEN ! linke Maustaste
mausx%=INT(MOUSEX/8)+1 ! ja, dann Spalte = mausx
mausy%=INT(MOUSEY/8)+1 ! Zeile = mausy
mausk%=MOUSEK ! Maustaste
ENDIF
RETURN
PROCEDURE tastendruck
PRINT AT(4,28);SPACE$(74);
PCOLOR 3,0
PRINT AT(16,28);"Weiter mit beliebiger Taste oder Mausklick."
maustaste ! auf Taste oder Mausklick warten
PCOLOR 1,0
PRINT AT(4,28);SPACE$(74)
RETURN
PROCEDURE tastendruck1
PRINT AT(4,28);SPACE$(74);
PCOLOR 3,0
PRINT AT(16,28);"Nächste Frage mit beliebiger Taste oder Mausklick."
maustaste ! auf Taste oder Mausklick warten
PCOLOR 1,0
PRINT AT(4,28);SPACE$(74)
RETURN
PROCEDURE testergebniss ! Testergebnis ausgeben
CLOSE ! alle offenen Dateien schließen
programmkopf
PCOLOR 6
PRINT AT(3,2);"A U S W E R T U N G D E R A N T W O R T E N I M F R A G E B O G E N"
PRINT AT(3,6);"Sie haben ";fraz%;" Fragen beantwortet"
IF fehlerpunkte%>2 THEN
PRINT AT(3,8);"Leider haben Sie dabei ";fehlerpunkte%;" Fehlerpunkte erzielt."
ENDIF
anweisung(27)
PCOLOR 3
IF fehlerpunkte%>8 THEN ! mehr als 8 Fehlerpunkte
PRINT AT(3,10);"In einer theoretischen Führerscheinprüfung wären sie damit durchgefallen!"
ELSE ! bis 8 Fehlerpunkte sind erlaubt
PRINT AT(18,8);"Sie haben diesen Test erfolgreich bestanden!"
PRINT AT(27,10);"Herzlichen Glückwunsch."
ENDIF
PCOLOR 6
PRINT AT(20,19);"Neuen Test"
PRINT AT(20,22);"Programm beenden"
COLOR 1
BOX 125,140,145,155 ! Abfragebox 'Neuer Test' zeichnen
BOX 125,165,145,180 ! Abfragebox 'Programm beenden' zeichnen
RETURN
PROCEDURE test.starten ! Test starten
ERASE hilfs%() ! Speicher löschen
DIM hilfs%(n%) ! Speicher dimensionieren
ini ! neuen Test starten
RETURN
PROCEDURE textstil(stil%,vfarbe%,hfarbe%)
par$=STR$(stil%)+";"+STR$(30+vfarbe%)+";"+STR$(40+hfarbe%)
PRINT CHR$(&H9B);par$;CHR$(&H6D);
RETURN
REM